Time Series Models on DOGE Coin Data

library(knitr)

curl 'https://api.nobitex.ir/market/udf/history?
symbol=DOGEIRT&resolution=D&to=1862230967'
-o DOGEIRT-D.json

import json
import pandas as pd
file = 'DOGEIRT-D'
with open(file+'.json') as train_file:
    dict1 = json.load(train_file)

# converting json dataset from dictionary to dataframe
df = pd.DataFrame(data=dict1)
df = df.drop('s', axis=1)
df['t'] = pd.to_datetime(df['t'],unit='s')
df = df.set_index('t')
df.index = pd.DatetimeIndex(df.index).to_period('D')
df.to_csv(file+'.csv')

d = read.csv("DOGEIRT-D.csv")
d$t = as.Date(d$t)
kable(head(d,2))

kable(tail(d,2))

df = data.frame(t = as.numeric(d[,1]-d[1,1]+1),c = d$c)
head(df)

library(plotly)
d %>% plot_ly(x = ~t, type="candlestick",
          open = ~o, close = ~c,
          high = ~h, low = ~l) 

library(zeallot)
res_prep = function(pred,lpred,lfun){
  res = matrix(nrow = length(lfun),ncol = length(lpred))
  rownames(res) = names(lfun)
  colnames(res) = names(lpred)
  colnames(pred) = names(lpred)
  for (i in 1:length(lfun)) {
    res[i,] = apply(pred,2,FUN = lfun[[i]])
  }
  return(list(pred = pred, res = res))
}

LTE = function(lpred,data,xname="t",yname="c",percent=0.8) {
  tr = head(data,round(nrow(data)*percent))
  ts = tail(data,nrow(data)-nrow(tr))
  
  extra.info = list()
  pred = matrix(nrow = nrow(ts))
  yind = which(colnames(ts)==yname)
  for (n in names(lpred)){
    lpred.out = lpred[[n]](tr,ts[,-yind,drop=FALSE])
    pred = cbind(pred,lpred.out[["pred"]])
    extra.info[[n]] = lpred.out[["extra.info"]]
  }
  pred = pred[,-1,drop=FALSE]
  
  lfun = list(RMSE=function(x) sqrt(mean((x-ts[,yname])^2)),MAD=function(x) mean(abs(x-ts[,yname])))
  c(pred,res) %<-% res_prep(pred,lpred,lfun)
  
  # Plot 
  fx = as.formula(paste("~",xname))
  fy = as.formula(paste("~",yname))
  fig = plot_ly(mode="lines", type = "scatter")%>%
  add_trace( data=tr, x = fx, y = fy,name = "train")%>%
  add_trace(data=ts, x = fx, y = fy,name = "test")
  
  for (n in colnames(pred))
    fig = fig %>% add_trace(x=ts[,xname],y=pred[,n],name = n)
  return (list(results = res, fig=fig, extra.info = extra.info))
}

STE = function(lpred,data,xname="t",yname="c",startp=0.97,sliding.time=30,is.plot=TRUE) {
  tr = head(data,round(nrow(data)*startp))
  ts = tail(data,nrow(data)-nrow(tr))
  
  fx = as.formula(paste("~",xname))
  fy = as.formula(paste("~",yname))
  fig.base = plot_ly(mode="lines", type = "scatter")%>%
  add_trace( data=tr, x = fx, y = fy,name = "train")%>%
  add_trace(data=ts, x = fx, y = fy,name = "test")
  
  pred.expand = matrix(nrow = nrow(ts),ncol = length(lpred))
  pred.slide = matrix(nrow = nrow(ts), ncol = length(lpred))
  yind = which(colnames(ts)==yname)
  for (i in 1:nrow(ts)){ 
    for (j in 1:length(lpred)){
      pred.slide[i,j] = lpred[[j]](tail(tr,sliding.time),ts[i,-yind,drop=FALSE])[["pred"]]
      pred.expand[i,j] = lpred[[j]](tr,ts[i,-yind,drop=FALSE])[["pred"]]
    }
    tr = rbind(tr,ts[i,])
  }
  
  lfun = list(RMSE=function(x) sqrt(mean((x-ts[,yname])^2)),MAD=function(x) mean(abs(x-ts[,yname])))
  c(pred.expand,res.expand) %<-% res_prep(pred.expand,lpred,lfun)
  
  c(pred.slide,res.slide) %<-% res_prep(pred.slide,lpred,lfun)
  
  
  # Plot expanding
  fig.ex = fig.base
  fig.sl = fig.base
  
  if(is.plot){
  for (n in colnames(pred.expand))
    fig.ex = fig.ex %>% add_trace(x=ts[,xname],y=pred.expand[,n],name = n)
  
  # Plot sliding
  for (n in colnames(pred.slide))
    fig.sl = fig.sl %>% add_trace(x=ts[,xname],y=pred.slide[,n],name = n)
  }
  
  return(list(expanding=list(res=res.expand,fig=fig.ex), sliding = list(res=res.slide,fig=fig.sl)))
}

f.fix <- function(fname,fixed) {
  variable = c("tr","ts")
  f.new <- function() {}
  formals(f.new) <- setNames(rep(list(bquote()), length(variable)), variable) 

  for(i in variable) assign(i, as.symbol(i))
  body(f.new) <- do.call("call", unlist(list(fname, fixed, mget(variable)),recursive = FALSE))
  
  return(f.new)
}

m.lm_poly = function(tr,ts,n=2,x=NULL){
  # Note that poly() returns Orthogonal Polynomials 
  if (!is.null(x)){ 
    tr = tr[,c("t","c",x),drop=FALSE]
    ts = ts[,c("t",x),drop=FALSE]
  }
  if (n==0)
    m = lm(c~.,tr)
  else
    m = lm(c~poly(t,n)+.,tr)
  return(list(pred = predict(m,ts), extra.info = m))
}

poly.list = list(Linear.Reg=f.fix("m.lm_poly",c(n=1)),
                   Quad.Reg=f.fix("m.lm_poly",c(n=2)),
                   Cubic.Reg=f.fix("m.lm_poly",c(n=3)),
                   Quartic.Reg=f.fix("m.lm_poly",c(n=4)) )
              
LTE.poly = LTE(poly.list,df,percent = 0.8)
LTE.poly$results

LTE.poly$fig

LTE.poly$results

STE.poly = STE(poly.list,df)
STE.poly$expanding$res

STE.poly$sliding$res

STE.poly$expanding$fig

STE.poly$expanding$res

STE.poly$sliding$fig

STE.poly$sliding$res

acf.res = acf(diff(df$c),lag.max = 40)

order(abs(acf.res$acf),decreasing = TRUE)[1:10] -1

df$L38 = factor(rep(1:38,length.out=nrow(df)))
head(df,n = 9)

LTE.sp38 = LTE(poly.list,df,percent = 0.8)
LTE.sp38$results

LTE.sp38$fig

LTE.sp38$results - LTE.poly$results

STE.sp38 = STE(poly.list,df,sliding.time = 38*2)
STE.sp38$expanding$res

STE.sp38$sliding$res

STE.sp38$expanding$fig

STE.sp38$expanding$res - STE.poly$expanding$res

STE.sp38$sliding$fig

STE.sp38$sliding$res - STE.poly$sliding$res

fsr.x = c()
for (i in 1:4){
  Sname = paste("S",i,"L38",sep = "")
  Cname = paste("C",i,"L38",sep = "")
  fsr.x = c(fsr.x,Sname,Cname)
  df[,Sname] = sin(2*pi*(i/38)*df$t)
  df[,Cname] = cos(2*pi*(i/38)*df$t)
}
head(df)

pf.list = list(Cubic.H1=f.fix("m.lm_poly",list(n=3,x=fsr.x[1:2])),
                Cubic.H2=f.fix("m.lm_poly",list(n=3,x=fsr.x[1:4])),
                Cubic.H3=f.fix("m.lm_poly",list(n=3,x=fsr.x[1:6])),
                Cubic.H4=f.fix("m.lm_poly",list(n=3,x=fsr.x[1:8]))
                )
LTE.pf = LTE(pf.list,df)
LTE.pf$results

LTE.pf$fig

LTE.pf$results

STE.pf = STE(pf.list,df)
STE.pf$expanding$res

STE.pf$sliding$res

STE.pf$expanding$fig

STE.pf$expanding$res

STE.pf$sliding$fig

STE.pf$sliding$res